-----------------------------------------------------------------------------
-- |
-- Module      : LLVM.Parser.Primitives
-- Copyright   : Mikhail Belyaev
-- License     : GPLv3 (see LICENSE)
--
--
-- This is a ErrBitGet-based realization for parsing LLVM Primitives.
--
-----------------------------------------------------------------------------

module LLVM.Parser.Bits.Primitives (
        getFBR,
        getVBR,
        getSixBitChar,
        getAlign32,
        getFBool
) where

import qualified Data.ByteString as BS
import LLVM.Parser.Bits.BitGet
import LLVM.Util
import Data.Bits
import Data.Word
import Data.Char

-- converting bytestring to an integer
-- (assuming it's a finite bs and it keeps BE bytes of integral data)
toIntegerBE :: BS.ByteString -> Integer
toIntegerBE bs =
        let shft y = toInteger y `shiftL` 8
            fn x y = x + shft y in
        BS.foldl fn 0 bs

-- geting a fixed bitstream integer of size bits
getFBR :: Int -> ErrBitGet Integer
getFBR bits
        | bits <= 8  = do value <- getAsWord8 bits
                          return $ toInteger value
        | bits <= 64 = do value <- getAsWord64 bits
                          return $ toInteger value
        | otherwise  = do bs <- getLeftByteString bits
                          return $ toIntegerBE  bs

-- geting a variable bitstream integer of size bits
getVBR :: Int ->  ErrBitGet Integer
getVBR bits =
             let head = bits - 1 in
             do
                chunk <- getFBR bits
                if(testBit chunk head)
                        then do
                                upperChunk <- getVBR bits
                                return $ clearBit chunk head + shiftL upperChunk head
                        else return chunk

-- getting a sixbit-encoded character
getSixBitChar :: ErrBitGet Char
getSixBitChar =
        -- TODO: replace with array (?)
        let table = ['a' .. 'z'] ++ ['A' .. 'Z'] ++ ['0' .. '9'] ++ ['.','_'] in
        do
                val <- getFBR 6
                -- TODO: list get (!!) is not constant (?), little wonder
                return $ table !! fromInteger val

-- align input so that it has read N*32 bits
getAlign32 :: ErrBitGet ()
getAlign32 = do proced <- failsafe bitsParsed
                if(proced `mod` 32 == 0)
                   then return ()
                   else
                        let asc = 32 - fromIntegral (proced `mod` 32) in
                        do
                           skip asc
                           return ()

-- getting 1 bit from the monad and converting it to Bool value
getFBool :: Int -> ErrBitGet Bool
getFBool bits = do val <- getFBR 1 -- TODO: casting one-bit Word to Integer is bad, I guess =(
                   return $ val /= 0
